home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / floati1a / modtoolb.bas < prev    next >
BASIC Source File  |  1999-04-10  |  4KB  |  112 lines
  1. Attribute VB_Name = "Module1"
  2. ' Docking tutorial brought to you by Nod Programming, Inc.
  3. ' Docking coded by Mike Lansing 'cheese'
  4. '
  5. ' email: nodprogramminginc@email.com
  6. ' url:   http://come.to/NodProgrammingInc
  7. '
  8. ' Code is free to use. Please notify me if you made any good changes to this code.
  9. ' This could be helpful for others. I spent my time on this for you, so please share
  10. ' with others. Be a giver not a taker.
  11.  
  12. Public turk As Integer
  13.  
  14. Public Type RECT
  15.     Left As Long
  16.     Top As Long
  17.     Right As Long
  18.     Bottom As Long
  19.     End Type
  20.  
  21. Public Type POINTAPI
  22.     X As Long
  23.     Y As Long
  24.     End Type
  25.     ' Window Setting Constants
  26.     Public Const WS_BORDER = &H800000
  27.     Public Const WS_NOBORDER = &H6000000
  28.     Public Const WS_EX_WINDOWEDGE = &H100
  29.     Public Const WS_THICKFRAME = &H40000
  30.     ' Misc Constants
  31.     Public Const GWL_STYLE = (-16)
  32.     Public Const GWL_HWNDPARENT = (-8)
  33.     Public Const COLOR_ACTIVECAPTION = 2
  34.     Public Const SM_CXDLGFRAME = 7
  35.     Public Const SM_CYDLGFRAME = 8
  36.  
  37. Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
  38. Public Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
  39. Public Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
  40. Public Declare Function DrawFocusRect Lib "user32" (ByVal hdc As Long, lpRect As RECT) As Long
  41. Public Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
  42. Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
  43. Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
  44.     Public tpoint As POINTAPI
  45.     Public temp As POINTAPI
  46.     Public dpoint As POINTAPI
  47.     Public fbox As RECT
  48.     Public tbox As RECT
  49.     Public oldbox As RECT
  50.     Public TwipsPerPixelX
  51.     Public TwipsPerPixelY
  52.     Public Moving As Boolean ' Window Control Constants
  53.     Public DockSetting As Integer
  54.     Public DockOption
  55. Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  56. Public Sub BeginFRDrag(X As Single, Y As Single)
  57.     Dim tDc As Long
  58.     Dim sDc As Long
  59.     Dim d As Long
  60.     ' convert points to POINTAPI struct
  61.     dpoint.X = X
  62.     dpoint.Y = Y
  63.     ' get screen area of toolbar
  64.     GetWindowRect frmToolbar.hwnd, fbox 'screen Rect of toolbar
  65.     TwipsPerPixelX = Screen.TwipsPerPixelX
  66.     TwipsPerPixelY = Screen.TwipsPerPixelY
  67.     ' get point of mousedown in screen coordinates
  68.     temp = dpoint
  69.     ClientToScreen frmToolbar.hwnd, temp
  70.     sDc = GetDC(ByVal 0)
  71.     DrawFocusRect sDc, fbox
  72.     d = ReleaseDC(0, sDc)
  73.     oldbox = fbox
  74.     Moving = True
  75. End Sub
  76. Public Sub DoFRDrag(X As Single, Y As Single)
  77.     If Moving = True Then
  78.         Dim tDc As Long
  79.         Dim sDc As Long
  80.         Dim d As Long
  81.         tpoint.X = X
  82.         tpoint.Y = Y
  83.         ClientToScreen frmToolbar.hwnd, tpoint
  84.         tbox.Left = (fbox.Left + tpoint.X / TwipsPerPixelX) - temp.X / TwipsPerPixelX
  85.         tbox.Top = (fbox.Top + tpoint.Y / TwipsPerPixelY) - temp.Y / TwipsPerPixelY
  86.         tbox.Right = (fbox.Right + tpoint.X / TwipsPerPixelX) - temp.X / TwipsPerPixelX
  87.         tbox.Bottom = (fbox.Bottom + tpoint.Y / TwipsPerPixelY) - temp.Y / TwipsPerPixelY
  88.         sDc = GetDC(ByVal 0)
  89.         DrawFocusRect sDc, oldbox
  90.         DrawFocusRect sDc, tbox
  91.         d = ReleaseDC(0, sDc)
  92.         oldbox = tbox
  93.     End If
  94. End Sub
  95. Public Sub EndFRDrag(X As Single, Y As Single)
  96.     If Moving = True Then
  97.         Dim tDc As Long
  98.         Dim sDc As Long
  99.         Dim d As Long
  100.         Dim newleft As Single
  101.         Dim newtop As Single
  102.         sDc = GetDC(ByVal 0)
  103.         DrawFocusRect sDc, oldbox
  104.         d = ReleaseDC(0, sDc)
  105.         newleft = X + fbox.Left * TwipsPerPixelX - dpoint.X
  106.         newtop = Y + fbox.Top * TwipsPerPixelY - dpoint.Y
  107.         frmToolbar.Move newleft, newtop
  108.         Moving = False
  109.     End If
  110. End Sub
  111.  
  112.